home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Almathera Ten Pack 3: CDPD 3
/
Almathera Ten on Ten - Disc 3: CDPD3.iso
/
scope
/
201-220
/
scopedisk214
/
fontlist
/
source
/
hardcopy.mod
< prev
next >
Wrap
Text File
|
1995-03-19
|
4KB
|
99 lines
(*------------------------------------------------------------------------------
Project : HardCopy
Module : HardCopy.mod
Author : Robert Brandner (rb)
Address : Schillerstr. 3 / A-8280 Fürstenfeld / AUSTRIA / EUROPE
Copyright : Public Domain
Language : Modula-II (M2Amiga V4.0d)
History : V0.99, 25-Mar 91, rb
History : , 22-Aug 91, rb adaptiert und optimiert für V4.0d
Contents : Hardcopy eines Rastports erzeugen.
------------------------------------------------------------------------------*)
(*$ StackChk := FALSE *)
(*$ RangeChk := FALSE *)
(*$ OverflowChk := FALSE *)
(*$ ReturnChk := FALSE *)
(*$ LongAlign := FALSE *) (* make this TRUE for MC680x0, x>1 *)
(*$ Volatile := FALSE *)
(*$ LargeVars := FALSE *)
(*$ StackParms := FALSE *)
IMPLEMENTATION MODULE HardCopy;
FROM Printer IMPORT IODRPReqPtr,IODRPReq,Special,SpecialSet,
dumpRPort,Error;
FROM ExecSupport IMPORT CreatePort,CreateExtIO,DeletePort,DeleteExtIO;
FROM ExecD IMPORT MsgPortPtr;
FROM ExecL IMPORT DoIO,OpenDevice,CloseDevice;
FROM SYSTEM IMPORT ADR,LONGSET;
FROM GraphicsD IMPORT RastPortPtr,ViewModeSet,ColorMapPtr;
(*--- Öffnen des Printer Devices ---------------------------------------------*)
PROCEDURE OpenPrinter(request:IODRPReqPtr):BOOLEAN;
BEGIN
OpenDevice(ADR("printer.device"),0,request,LONGSET{});
RETURN (request^.error=noErr);
END OpenPrinter;
(*--- Erzeugen eines IO-Requests ---------------------------------------------*)
PROCEDURE CreateIOReq():IODRPReqPtr;
VAR printport:MsgPortPtr;
req:IODRPReqPtr;
BEGIN
printport:=CreatePort(NIL,0); (* MessagePort erzeugen *)
IF printport=NIL THEN RETURN NIL END; (* nicht geklappt->NIL *)
req:=CreateExtIO(printport,SIZE(IODRPReq)); (* IORequest erzeugen *)
IF req=NIL THEN (* wenn nicht geklappt *)
DeletePort(printport) (* Port wieder schließen*)
END;
RETURN req; (* Request als Ergebnis *)
END CreateIOReq;
(*--- Port und IORequest wieder schließen ------------------------------------*)
PROCEDURE CleanUp(VAR req:IODRPReqPtr);
VAR port:MsgPortPtr;
BEGIN
IF req#NIL THEN
port:=(req^.message.replyPort);
DeleteExtIO(req); req:=NIL;
DeletePort(port);
END;
END CleanUp;
(*--- Hardcopy ausgeben, mittels Printer Device ------------------------------*)
PROCEDURE DumpRPort(rp:RastPortPtr;cm:ColorMapPtr;vm:ViewModeSet;
x0,y0,w,h:CARDINAL;prtw,prth:LONGINT;
s:SpecialSet;VAR err:Error):BOOLEAN;
VAR request:IODRPReqPtr;
BEGIN
request:=CreateIOReq(); (* Request erzeugen *)
IF request=NIL THEN RETURN FALSE END; (* Fehler melden. *)
IF NOT OpenPrinter(request) THEN (* Versuche Printer zu öffnen *)
CleanUp(request); (* nicht ok: Request entfernen*)
RETURN FALSE (* Fehler melden. *)
END;
WITH request^ DO (* Request-Struktur beschreib.*)
command:=dumpRPort; (* Ich will eine Hardcopy *)
rastPort:=rp; (* von diesem Rastport, und *)
colorMap:=cm; (* mit diesen Farben. *)
modes:=vm; (* Hires oder Lace Screen ? *)
srcX:=x0; srcY:=y0; (* Ausschnitt des Rastport *)
srcWidth:=w; srcHeight:=h; (* der gedruckt werden soll. *)
destCols:=prtw; destRows:=prth; (* Größe des Ausdrucks. *)
special:=s; (* SpecialFlags siehe [RKM] *)
END;
DoIO(request); (* Request an Printer schicken*)
err:=request^.error; (* event. Fehler merken *)
CloseDevice(request); (* Device schließen. *)
CleanUp(request); (* Request entfernen. *)
RETURN (err=noErr); (* Ergebnis zurückgeben. *)
END DumpRPort;
END HardCopy.mod